---
title: "CENSUS2020 - Propencity to Participate Explorer -Draft V0.2"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
    theme: lumen
---

```{r setup, include=FALSE}
library(flexdashboard)
library(crosstalk)
library(leaflet)
library(leaflet.extras)
library(plotly)
library(DT)
library(sf)
library(dplyr)
library(tidyr)
library(tidyselect)
library(ggplot2)

df_1 <- readRDS("data/df_1.rds")
df_fin <- readRDS("data/df_fin.rds")
df_fin_2 <- df_fin %>% 
             mutate(tract_blockgrp = paste0(tract,"_",block_group)) %>% 
             select(tract_blockgrp, everything()) 


#options(persistent = TRUE)

sd1 <- SharedData$new(df_1)
#sd2 <- SharedData$new(df_fin %>% select(-popup_text))
sd2 <- SharedData$new(df_fin_2 %>% select(-popup_text))

```

Inputs {.sidebar}
-----------------------------------------------------------------------


```{r selectors}
filter_slider("rspns_score", "Propensity", sd2, ~rspns_score,  step = 1)
filter_select("tract_blockgrp", "Select Tract and block group: ex 002102_1", sd2, ~tract_blockgrp, multiple = FALSE)
filter_select("tarct", "Select Tract by number: ex 002102", sd2, ~tract, multiple = FALSE)#, selected = "000100")
filter_checkbox("block_group", "Block Group", sd2, ~block_group, inline = TRUE) 
```
  
Column {.tabset .tabset-fade}
-------------------------------------
 
### DC Tract and Block Group 

```{r LeafLetMap_1}

pal <- colorNumeric(palette = "Reds",
                    domain = df_fin$rspns_score)

dc_leaf <- leaflet(df_fin) %>%
               addProviderTiles("CartoDB.DarkMatter") %>%
               setView(lng = -77.03687, lat = 38.90717, zoom = 12) %>%
               addResetMapButton() %>%
              addPolylines(data = sd1 ,
                         stroke = TRUE, 
                   smoothFactor = 1,
                         weight = 1, 
                          color = "gray"
                           ) %>% 
               addPolygons(data = sd1,
                          color = "#444444", 
                      dashArray = "3",
                         weight = 2,   #line thickness 
                   smoothFactor = 0.5,
                        opacity = 0.5,
                    fillOpacity = 0.5,
               highlightOptions = highlightOptions(color = "green", weight = 5,bringToFront = TRUE), 
                          popup = df_fin$popup_text,
                          label = ~trct_blk
                           ) %>% 
              addLegend( position = "bottomleft", 
                              pal = pal, 
                           values = ~rspns_score,
                            title = "Propensity",
                          opacity = .8
                              ) %>%
              addCircleMarkers(data = sd2,
                             radius = .001, 
                              color = ~pal(df_1$rspns_score),
                              group = "BlockGroup"
                               ) %>%
            addMiniMap(tiles = providers$Esri.WorldStreetMap,
               toggleDisplay = T)       
dc_leaf
```

### The Data Table 
```{r dataTable_1}
datatable(sd2, rownames = TRUE, extensions = 'Scroller', options = list(
          scrollY = 200,
          scroller = TRUE
          ))
```

### Documentation 
TABLE OF CONTENT  

1. **Application Motivation**  
1. **Application description**  
1. **Application features**  
1. **Data dictionary**  



 Application Motivation 
Building tools to identify low responding communities in the 2020 National Census as part of the Census Bureau's Opportunity Project.


 Application description
 Short:
This web application intend to identifying low participating communities in the upcoming Census 2020 to aid a special outreach  program design and increase participation.

 Long: 
The application uses data from 2010 Census and 2013-2017 American community survey. For now, the application is limited to the District of Columbia (DC), and it includes block group level information. 

The application focuses on households who do not speak english very well or use language other than english in the household for all 450 block groups and 179 tracts in DC.

A participation propensity response_score ranging from 2-49 is assigned to each one of the 450 block groups for DC (source US Census).  A smaller response_score number indicates high participation, and a high response_score indicate low participation. A light to darker color schema is applied to the markers for each block group. A lighter color indicate high participation and darker color indicate low participation.

 Application features 


 Controls:-
There are four sidebar control that can be used to filter content. The propensity slider (1), the drop down combined tract/block group selector(2), the tract selector (3) and block group selector(4).  The last two features should be used in combination to zoom in on block group of interest. 

 Window pans:- 
There are four window pans including the map (1), bar chart for window 2), the propensity scatter plot (3) and the searchable datable(4). When applying the control features, each window content updates dynamically to match the selected tract and block groups. 

 Hover Effect:-
When a mouse is hovered over the map, each block group is highlighted with green line, and a popup appears showing the tract and block group number.

 Popup Text:- 
When the marker in each block group is clicked with a mouse, a popup appears and display the tract, block group, response score and the percentages of the four group population who do not speak english very well, or use language other than english in the household. 


 Data dictionary 

```{r, eval=TRUE}
library(kableExtra)
data <- read.csv("data/var_data_dictionary.csv")
data %>% 
        kable("html", escape = F) %>%
        kable_styling(bootstrap_options = "striped", "hover", full_width = F, font_size = 12)
```

Column {data-width=400}
-------------------------------------
   
### Language

```{r LangBarChart}
plot_ly(sd2, x = ~tract, y = ~spanish, type = 'bar', name = 'spanish or spanish creol') %>%
    add_trace(y = ~indoEuro, name = 'Indo European') %>%
    add_trace(y = ~api, name = 'Asian & Pacific Island') %>%
    add_trace(y = ~other, name = 'Other') %>%
    layout(yaxis = list(title = 'Percent'), barmode = 'group')
```   
 
### Propensity Index
    
```{r scorePlot_1}
library(plotly)
p2 <- plot_ly(sd2, x = ~mail_return, 
                   y = ~rspns_score, 
               color = ~rspns_score, 
              colors = 'Reds') %>%
        add_markers() 
p2
```